perm filename GEN.F4[JC,MUS]2 blob
sn#079076 filedate 1973-12-22 generic text, type T, neo UTF8
00100
00200 SUBROUTINE GEN(FUN)
00300 C AFTER 'SYNTH(F1);' TYPE 99= TO USE H,A,P,K: ALL OTHER
00400 C NUMBERS = H,A ONLY. TYPE 999 TO END. NORMALIZATION IS AUTOMATIC.
00500 DIMENSION FUN(50)
00600 COMMON FREQ(3,0/50,50),FUNC(50),AMP(50),II(1),IJJ(3000)
00700 3002 TYPE 1002
00800 1002 FORMAT(' 0 TO CLEAR ELSE 1'/)
00900 ACCEPT 201,AB
01000 IF(AB.NE.0.0)GO TO 1001
01100 DO 15 I=1,50
01200 15 FUN(I)=0.0
01300 201 FORMAT(4F)
01400 1001 FAC=360./50.
01500 16 CALL DPYSET(1,IJJ,3000)
01600 CALL ALINE(0,0,200,0)
01700 CALL ALINE(0,100,0,0)
01800 TYPE 445
01900 445 FORMAT(' TYPE H,A,P,K OR 999'/)
02000 ACCEPT 201,H,AMPL,X,CON
02100 IF(H.EQ.999.)GO TO 446
02200 X=X*50./360.
02300 2016 DO 17 J=1,50
02400 XK=SIND(X*FAC)*AMPL+CON
02500 IF(CON.LT.100.0)GO TO 1
02600 FUN(J)=(XK-100.)*FUN(J)
02700 GO TO 2
02800 1 FUN(J)=FUN(J)+XK
02900 2 X=X+H
03000 IY=FUN(J)*100.
03100 IX=J*4
03200 CALL AVECT(IX,IY)
03300 IF(X.LE.50.)GO TO 17
03400 X=X-50.
03500 17 CONTINUE
03600 CALL DPYOUT(1)
03700 GO TO 16
03800 446 CALL DPYSET(1,IJJ,3000)
03900 CALL ALINE(0,0,200,0)
04000 CALL ALINE(0,100,0,0)
04100 2200 X=FUN(1)
04200 DO 19 I=2,50
04300 H=ABS(FUN(I))
04400 19 IF(X.LT.H)X=H
04500 DO 20 I=1,50
04600 FUN(I)=FUN(I)/X
04700 IY=FUN(I)*100.
04800 IX=(I-1)*4
04900 20 CALL AVECT(IX,IY)
05000 CALL DPYOUT(1)
05100 PAUSE
05200 CALL HYDPOG(1)
05300 RETURN
05400 END